home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 5 / BBS in a Box -Volume V (BBS in a Box) (April 1992).iso / Files / Prog / S / SortScreen.cpt / SortScreen.asm / SortScreen.asm
Encoding:
Assembly Source File  |  1988-07-21  |  8.7 KB  |  443 lines  |  [TEXT/MPS ]
  1.     ftype    'APPL'
  2.     fsign    'TesT'
  3.  
  4.     incl    "All Traps.PSM"
  5.  
  6. ScreenRow    equ    $106
  7.  
  8.     a5Sec
  9. TheBlock    ds.l    1
  10.     a5End
  11.  
  12.  
  13. ;--------------------------------------------------------------
  14. ;---         5 Sorts Demonstration
  15. ;---
  16. ;---     A. Initialize the System
  17. ;---        (Note! _Random #'s are not valid before _InitGraf!
  18. ;---    
  19. ;---    B. Allocate a block of Memory and Fill with random #'s
  20. ;---        and
  21. ;---    C. Sort the block using;
  22. ;---          1. Bubble Sort
  23. ;---        2. SelectionSort
  24. ;---        3. InsertionSort
  25. ;---        4. ShellSort
  26. ;---        5. QuickSort
  27. ;-------------------------------------------------------------
  28. ;---        These are the Rules
  29. ;---    1. Each element in the block is a WORD in length
  30. ;---    2. The number $FACE is placed at the end
  31. ;---       of the block as a marker (debugging)
  32. ;---    3. N is the number of words in the block
  33. ;---    4. The sort is by signed word
  34. ;---    5. These subroutines were coded and tested for blocks
  35. ;---       of up to 500K. (Not recommended for bubble sort)
  36. ;---    Note that in some cases simply inverting the comparisons
  37. ;---    from BGT to BLT will reverse the order of the sort
  38.  
  39.  
  40. ;     Procedure  BubbleSort    ( N:LongInt ; p:Pointer )
  41. ;     Procedure  SelectionSort    ( N:LongInt ; p:Pointer )
  42. ;     Procedure  InsertionSort    ( N:LongInt ; p:Pointer )
  43. ;     Procedure  ShellSort    ( N:LongInt ; p:Pointer )
  44. ;     Procedure  QuickSort    ( N:LongInt ; p:Pointer )
  45.  
  46. ; You are welcome to use these sorts in any of your programs
  47. ; based on one of the following license programs;
  48.  
  49. ;    a.  Pay me one Italian Lire for each number sorted.
  50. ;            or
  51. ;    b.  Mention my name if you use QuickSort.
  52. ;            or
  53. ;    c.  Go to church next sunday.
  54. ;
  55. ;        ***Please consult your lawyer***
  56.  
  57.  
  58.  
  59. OutOfSorts
  60.     pea    -4(a5)
  61.     _InitGraf
  62.     _InitFonts
  63.     _InitWindows
  64.     _InitMenus
  65.     clr.l    -(sp)    
  66.     _InitDialogs
  67.     _TEInit
  68.  
  69. ;
  70.     move.l    -4(a5),a0        a0 = ptr to QuickDraw globals
  71.  
  72.     move.w    12(a0),d7        Screen Height *
  73.     muls    ScreenRow,d7    Bytes/Line
  74.     lsr.l    #1,d7        /2 = Words on the Screen
  75.  
  76.  
  77.     move.l    $824,TheBlock
  78.  
  79. ;******************************************************
  80. ; If you want to use a nonrelocatable block in memory
  81. ; you could do it this way
  82. ;N    equ    YourSize
  83. ;    move.l    #N,d7        You choose the size
  84. ;    move.l    d7,d0
  85. ;    add.l    d0,d0        Blocksize = N* 2 bytes/word
  86. ;    addq.l    #2,d0        + word marker #$FACE
  87. ;    _NewPtr
  88. ;    tst.w    d0
  89. ;    bmi    Error
  90. ;    move.l    a0,TheBlock
  91. ;******************************************************
  92.  
  93. ; in this program, d7 will hold #N
  94. ; If you want different sized blocks to be allocated and sorted
  95. ; just place your value into d7 here
  96.  
  97.  
  98.     bsr    FillBlock
  99.  
  100.     move.l    d7,-(sp)
  101.     move.l    TheBlock,-(sp)
  102.     bsr    BubbleSort
  103.  
  104.     bsr    FillBlock
  105.  
  106.     move.l    d7,-(sp)
  107.     move.l    TheBlock,-(sp)
  108.     bsr    SelectionSort
  109.  
  110.     bsr    FillBlock
  111.  
  112.     move.l    d7,-(sp)
  113.     move.l    TheBlock,-(sp)
  114.     bsr    InsertionSort
  115.  
  116.     bsr    FillBlock
  117.  
  118.     move.l    d7,-(sp)
  119.     move.l    TheBlock,-(sp)
  120.     bsr    ShellSort
  121.  
  122.     bsr    FillBlock
  123.  
  124.     move.l    d7,-(sp)
  125.     move.l    TheBlock,-(sp)
  126.     bsr    QuickSort
  127.  
  128.     Rts
  129.  
  130.  
  131. ; The Bubble Sort algorithm is dedicated to STOP pipe tobacco
  132. ; (Alfred & Christian Peterson, Horsens, Danmark)
  133. ; because sometimes it seems as though it never will.
  134.  
  135. ;  Pass through block repeatedly, exchanging adjacent elements
  136. ;  until exchanges = 0
  137.  
  138. BubbleSort
  139.     movem.l    d3/d4/a2,-(A7)
  140.     move.l    20(sp),d4
  141.     sub.l    #2,d4        D2 = Block counter
  142.     bmi.s    NoBubbles
  143.     move.l    16(sp),a2
  144.  
  145. DoBS    move.l    d4,d2
  146.     moveq    #0,d3        d3 = exchanges
  147.     move.l    a2,a0
  148.     lea    2(a0),a1
  149.  
  150. NextBubble
  151.     cmpm.w    (a0)+,(a1)+
  152.     bge.s    InOrder        BLE Reverses sort order
  153.  
  154.     move.w    (a0),d0
  155.     move.w    -2(a0),(a0)    Swap the Numbers
  156.     move.w    d0,-2(a0)
  157.     addq.l    #1,d3        mark exchange
  158.  
  159. InOrder    subq.l    #1,d2
  160.     bpl    NextBubble
  161.     tst.l    d3        Exchanges = 0?
  162.     bne.s    DoBS          >No, Start from the beginning
  163. NoBubbles    movem.l    (sp)+,d3/d4/a2    >Yes, all done
  164.     move.l    (sp)+,a0
  165.     addq.w    #8,sp
  166.     jmp    (a0)
  167.  
  168.  
  169. ;  Selection Sort Algorithm
  170. ;
  171.  
  172. SelectionSort
  173.     move.l    a2,-(A7)
  174.     move.l    12(sp),d2        D2 = Block counter
  175.     subq.l    #1,d2
  176.     ble.s    SFinish
  177.     move.l    8(sp),a2        A2 = Unsorted Base
  178.     bra.s    .first
  179.  
  180. SFinish    movem.l    (sp)+,a2    >Yes, all done
  181.     move.l    (sp)+,a0
  182.     addq.w    #8,sp
  183.     jmp    (a0)
  184.  
  185.  
  186. NxtSel    subq.l    #1,d2
  187.     bmi    SFinish
  188.     move.w    (A2),D3
  189.     move.w    (a1),(A2)+    A2 is Updated each pass
  190.     move.w    d3,(a1)        After each # is added
  191.  
  192. .first    move.l    d2,d1
  193.     move.w    (A2),d0
  194.     move.l    A2,a1        A1 = Address of the smallest #
  195.     lea    2(A2),a0        A0 = next # to compare to (a1)
  196.  
  197. D0Cmp    subq.l    #1,d1
  198.     bmi    NxtSel
  199.     cmp.w    (a0)+,d0
  200.     blt    D0Cmp
  201.     move.l    a0,a1
  202.     move.w    -(a1),d0
  203.     bra    D0Cmp
  204.  
  205.  
  206. ;  Note that Insertion Sort is the Quickest of all for a
  207. ;  sorted block (Quicksort is the worst!).
  208.  
  209. InsertionSort
  210.     link    a6,#0
  211.     movem.l    d3/a2/a3,-(sp)
  212.     move.L    8(A6),A3
  213.     move.L    12(A6),D2
  214.     moveq    #0,d1
  215.     moveq    #0,d0        D0 = CMP Register
  216.     move.l    a3,A2        a3 = Base of Block
  217.     moveq    #-1,d3
  218.     lea    2(a3),a0
  219.     subq.l    #1,d2
  220.  
  221. NextInsert
  222.     addq.l    #1,d3        d3 = Insert Block Size
  223.     cmp.l    d3,d2
  224.     ble.s    Ifinished
  225.     move.l    a0,A2
  226.     move.w    (a0)+,d0        New Entry> D0
  227.  
  228. NextPos
  229.     move.w    -(A2),d1
  230.     cmp.w    d0,d1
  231.     bge.s    Trade
  232.  
  233.     move.w    d0,2(A2)        Drop
  234.     bra.s    NextInsert
  235.  
  236. Trade    move.w    d1,2(A2)        Swap
  237.     move.w    d0,(A2)
  238.     cmp.l    a3,A2
  239.     bne.s    NextPos
  240.     bra.s    NextInsert
  241.  
  242. IFinished    movem.l    (sp)+,d3/a2/a3
  243.     unlk    a6
  244.     move.l    (sp)+,a0
  245.     addq.w    #8,sp
  246.     jmp    (a0)
  247.  
  248. ;--------------------------------------------------------
  249. ;--- This is ShellSort stolen from MacNosey
  250. ;--- as demanded by it's author, Steve Jasik.
  251. ;--- I modified it somewhat to handle bigger blocks.
  252. ;
  253. ;  Shell Sort Algorithm
  254. ; N =     5000       Time=    0.5 Seconds
  255. ;   =    10000        0.9
  256. ;   =    20000              1.5
  257.  
  258. ShellSort    LINK    A6,#0
  259.     MOVEM.L    D3-D7/A2-A3,-(SP)
  260.     MOVEA.L    8(A6),A2        ; tbl addr
  261.     MOVE.L    12(A6),D7        ; n
  262.     CMPI.L    #1,D7
  263.     BLE.S    luj_6        ; if n <= 1
  264.     LEA    HTable,A1
  265.     moveq    #0,d0
  266.     moveq    #0,d2
  267. luj_1    ADDQ.l    #4,D0        ; k := k + 1
  268.     MOVE.l    0(A1,D0.l),D3
  269.     CMP.l    D7,D3        ; if gap <= n
  270.     BLT.S    luj_1
  271.     LSL.L    #1,D7
  272.     SUBQ.L    #2,D7        ; d7 = 8*n-8
  273. luj_2    SUBQ.l    #4,D0        ; k := k - 1
  274.     MOVE.l    0(A1,D0.l),D3
  275.     LSL.l    #1,D3
  276.     MOVE.l    D3,D1
  277. luj_3    MOVE.w    (A2,D1.l),D4
  278.     MOVE.l    D1,D2
  279.     SUB.l    D3,D2
  280.     MOVEA.L    A2,A3
  281.     ADDA.l    D3,A3
  282. luj_4    TST.l    D2
  283.     BLT.S    luj_5
  284.     MOVE.w    0(A2,D2.l),D6
  285.     CMP.w    D4,D6
  286.     BLE.S    luj_5
  287.     MOVE.w    D6,0(A3,D2.l)
  288.     SUB.l    D3,D2
  289.     BRA.S    luj_4
  290. luj_5    MOVE.w    D4,0(A3,D2.l)
  291.     ADDQ.l    #2,D1
  292.     CMP.l    D7,D1
  293.     BLE.S    luj_3
  294.     TST.l    D0
  295.     BNE.S    luj_2
  296. luj_6    MOVEM.L    (SP)+,D3-D7/A2-A3
  297.     UNLK    A6
  298.     MOVE.L    (SP)+,A0
  299.     ADDQ    #8,SP
  300.     JMP    (A0)
  301.  
  302. ; Next = (Prev*3)+1
  303. HTable    DC.l    1,4,$D,$28,$79,$16C,$445,$CD0
  304.     dc.l    $2671,$7354,$159FD,$40DF8,$C29CE9
  305.  
  306.  
  307. ; QuickSort, invented by C. Hoare in 1960
  308. ; Written for the MC68K by John Shepardson
  309. ; This method is so quick that it sorts the numbers
  310. ; faster than they are generated in FillBlock!
  311.  
  312. QuickSort    lea    8(a7),a0
  313.     movem.l    d3-d7/a2-a4,-(sp)
  314.     move.l    (a0),d0        N*2 in d0
  315.     asl.l    #1,d0
  316.     ble    QSRtn
  317.     move.l    d0,-(sp)
  318.     move.l    -(a0),-(sp)
  319.     pea    QSRtn
  320.     moveq    #2,d4        D4 = Constant #2
  321.  
  322. ; we could just enter here and skip the above stack bashing
  323. ; except that registers d3-d7/a2-a4 would not be restored
  324. ; and N would have to be multiplied * 2 before calling
  325.  
  326. QSJob    move.l    (sp)+,a3        a3 -> Return
  327.     move.l    (sp)+,a4        a4 -> Block
  328.     move.l    (sp)+,d7        D7 =  Block Size
  329.  
  330. ; PV = Partition Value
  331. QSReg    lea    (a4,d7.l),a1    A1 -> End
  332.     move.w    -(a1),d0        Last element = PV
  333.     move.l    a4,a0        A0 -> Front
  334.     move.l    d7,d2        D2 = Counter for A0
  335.     subq.l    #2,d2
  336.     move.l    d2,d3        D3 = Counter for A1
  337.  
  338. ; Search from Start to end for an element >= d0
  339.  
  340. NextUp    cmp.w    (a0)+,d0    Undwinding loops
  341.     ble.s    NextDwn    Speeds up execution
  342.     subq.l    #2,d2
  343.     bmi.s    NextDwn
  344.     cmp.w    (a0)+,d0
  345.     ble.s    NextDwn
  346.     subq.l    #2,d2
  347.     bmi.s    NextDwn
  348.     cmp.w    (a0)+,d0
  349.     ble.s    NextDwn
  350.     subq.l    #2,d2
  351.     bmi.s    NextDwn
  352.     cmp.w    (a0)+,d0
  353.     ble.s    NextDwn
  354.     subq.l    #2,d2
  355.     bmi.s    NextDwn
  356.     cmp.w    (a0)+,d0
  357.     ble.s    NextDwn
  358.     subq.l    #2,d2
  359.     bpl.s    NextUp
  360.  
  361. ;------------------------------------------------
  362.  
  363. ; Search from End to Start  for a #<= d0
  364. NextDwn    cmp.w    -(A1),d0
  365.     bge.s    ExchQS
  366.     subq.l    #2,d3
  367.     bmi.s    ExchQS
  368.     cmp.w    -(A1),d0
  369.     bge.s    ExchQS
  370.     subq.l    #2,d3
  371.     bmi.s    ExchQS
  372.     cmp.w    -(A1),d0
  373.     bge.s    ExchQS
  374.     subq.l    #2,d3
  375.     bmi.s    ExchQS
  376.     cmp.w    -(A1),d0
  377.     bge.s    ExchQS
  378.     subq.l    #2,d3
  379.     bmi.s    ExchQS
  380.     cmp.w    -(A1),d0
  381.     bge.s    ExchQS
  382.     subq.l    #2,d3
  383.     bpl.s    NextDwn
  384.  
  385. ExchQS    cmp.l    a0,a1        Have they Crossed?
  386.     blt.s    LastSwap
  387.  
  388.     subq.l    #2,d3        No, exchange
  389.     subq.l    #2,d2        & continue search
  390.     move.w    -2(A0),d1
  391.     move.w    (A1),-2(A0)
  392.     move.w    d1,(A1)
  393.     bra    NextUp
  394.  
  395. LastSwap    move.w    -2(a0),-2(a4,d7.l)    Yes, last exchange
  396.     move.w    d0,-2(a0)        places the PV into
  397.     addq.l    #2,d3        it's final position
  398.  
  399.     cmp.l    d4,d3    if elements = 1 or 0, Don't sort
  400.     bgt.s    QS2jobs
  401.     sub.l    D3,d7
  402.     move.l    a0,a4
  403.     cmp.l    d4,d7    1 job left in registers
  404.     bgt.s    QSReg
  405.     jmp    (a3)    0 jobs left in registers, exit
  406.  
  407. QS2jobs    sub.l    D3,d7
  408.     cmp.l    d4,d7
  409.     ble.s    .npush
  410.     move.l    d7,-(sp)
  411.     move.l    a0,-(sp)    To recurse really is Divine!
  412.     move.l    a3,-(sp)
  413.     Lea    QSJob,a3    1 job placed on stack
  414.  
  415. .npush    subq.l    #4,d3
  416.     move.l    d3,d7    & 1 job left in registers
  417.     cmp.l    d4,d7
  418.     bgt.s    QSReg
  419.  
  420. QDone    jmp    (a3)
  421.  
  422. QSRtn    movem.l    (sp)+,d3-d7/a2-a4
  423.     move.l    (sp)+,a0
  424.     addq.l    #8,sp
  425.     jmp    (a0)
  426.  
  427.  
  428. Error    dc.w    $a9ff    No Block to allocate
  429.     _ExittoShell     so lets go home
  430.  
  431.  
  432. FillBlock    move.l    d7,d3        with Random Numbers
  433.     move.l    TheBlock,a2
  434. NxtRand    clr.w    -(sp)
  435.     _Random
  436.     move.w    (sp)+,(a2)+
  437.     subq.l    #1,d3
  438.     bne    NxtRand
  439.     move.w    #$FACE,(a2)+    Place marker at end
  440.     rts
  441.  
  442.  
  443.     end